( Hunt the Wumpus - JCB 16:42 01/15/11)
( Converted for Forth-83 - Mark Wills August 2015 )
( from ANS code written by James Bowman. )
( Original program here: )
( http://excamera.com/sphinx/article-wumpus.html#wumpus )
(   Changes: )
(     definition RANDOM removed. Not needed for Turboforth )
(     defintion @+ removed - TurboForth has @++ )
(     definition 2VARIABLE added )
(     definition 2@ added )
(     definition 2! added )
decimal
forget 2variable
: 2variable ( execution: a-addr )
  \ MRW 5th August 2015
  create 0 , 0 , ;
  
: 2@ ( a-addr -- x1 x2 )
  \ MRW 5th August 2015
  dup 2+ @ swap @ ;

: 2! ( x1 x2 a-addr -- )
  \ MRW 5th August 2015
  swap over ! 2+ ! ;
  
: m 1- , ; \ original map was 1-based, we are 0-based
: triples create does> swap 3 * cells + ;

triples map ( r -- addr ) \ address of room r
2 m 5 m 8 m 1 m 3 m 10 m 2 m 4 m 12 m 3 m 5 m 14 m 1 m 4 m 6 m
5 m 7 m 15 m 6 m 8 m 17 m 1 m 7 m 9 m 8 m 10 m 18 m 2 m 9 m 11 m
10 m 12 m 19 m 3 m 11 m 13 m 12 m 14 m 20 m 4 m 13 m 15 m 6 m 14 m 16 m
15 m 17 m 20 m 7 m 16 m 18 m 9 m 17 m 19 m 11 m 18 m 20 m 13 m 16 m 19 m
20 m 20 m 20 m \ impossible room for lost arrow

: randroom ( -- n )
    20 rnd ;

variable you
variable wumpus
2variable pits
2variable bats

: bounds ( a n -- a+n a )
    over + swap ;

: exits ( u -- u0 u1 u2 ) \ exits for room u
    map @++ swap @++ swap @ ;

: isexit ( e r -- f) \ is e an exit for room r
    map
    2dup @ = >r cell+
    2dup @ = >r cell+
    @ = r> or r> or ;

: nearyou ( r -- f ) \ is room r next to player
    you @ isexit ;

: 2nearyou ( r0 r1 -- f ) \ is either room next to player
    >r nearyou r> nearyou or ;

: atyou ( r -- f ) \ is player at room r
    you @ = ;

: 2atyou ( r0 r1 -- f ) \ is player at room
    >r atyou r> atyou or ;

: getroom ( -- n ) \ input room number from console
    tib @ 5 expect
    bl word number drop ;

: warn ( addr u f -- ) \ if f, type line addr,u
    if cr type else 2drop then ;

variable gameover

: endgame ( addr u -- )
    cr type true gameover ! ;

: losegame ( addr u -- )
    endgame 
    cr ." HA HA HA - YOU LOSE!" ;

: wingame ( addr u -- )
    endgame
    cr ." HEE HEE HEE - THE WUMPUS'LL GETCHA NEXT TIME!!" ;

: wakewumpus ( -- )
    4 rnd dup 3 = if
        drop \ wumpus stays
    else
        \ wumpus moves
        cells wumpus @ map + @ wumpus !
    then
    wumpus @ atyou if
        s" TSK TSK TSK- WUMPUS GOT YOU!" losegame
    then ;

: moveplayer ( r -- c ) \ move player to room r, check for hazards
    you !
    wumpus @ atyou if
        cr ." OOPS! BUMPED A WUMPUS"
        wakewumpus
    then
    pits 2@ 2atyou if
        s" YYYIIIIEEEE . . . FELL IN PIT" losegame
    then
    bats 2@ 2atyou if
        cr ." ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!"
        randroom recurse
    then ;

: domove
    begin
        cr ." Where to? " getroom
        dup nearyou 0=
    while
        cr ." -Not possible"
    repeat
    moveplayer ;

: doshoot
    begin
        cr ." No. of rooms (1-5) "
        getroom
        dup 1 6 within
    until
    you @ swap \ arrow position on stack
    0 do
        cr ." ROOM #" i . ." ? "
        getroom 2dup isexit
        if nip else 2drop 20 then
        wumpus @ over = if
            s" AHA! YOU GOT THE WUMPUS!" wingame leave 
        then
    loop
    gameover @ 0= if
        cr ." Missed"
    then
    drop ;

: upper ( a -- a|a-32) \ convert a character to upper case
    dup 96 > if 32 - then ;

: pick1 ( k0 k1 -- k ) \ wait for key k0 or k1
    begin
        key upper >r
        over r@ = over r@ = or
    until ;

: gameloop
    cr
    s" I smell a Wumpus!" wumpus @ nearyou warn
    s" I feel a draft!" pits 2@ 2nearyou warn
    s" Bats nearby!" bats 2@ 2nearyou warn
    cr ." You are in room " you @ .
    cr ." Tunnels lead to " you @ exits . . .
    cr ." Shoot or move (S-M)? "
    begin
        key upper dup ascii M = over ascii S = or
    until
    dup emit ascii M = if
        domove
    else
        doshoot wakewumpus
    then ;

: cheat
    cr ." you " you @ .
    ." wumpus " wumpus @ .
    ." bats " bats 2@ . .
    ." pits " pits 2@ . . ;

: setup
    20 0 do i loop
    50 0 do
        randroom roll
    loop
    you ! wumpus ! bats 2! pits 2!
    14 0 do drop loop ;

: wait ( -- ) \ wait for key and clear screen
  0 23 gotoxy ." Press any key..."
  begin key? -1 > until page ;

: instructions
cr ." WELCOME TO 'HUNT THE WUMPUS'" cr
cr ." the wumpus lives in a cave of 20 rooms. "
   ." Each room has 3 tunnels leading to other"
   ." rooms. (look at a dodecahedron to see   "
   ." how this works - if you don't know what "
   ." a dodecahedron is, ask someone!)" cr
cr ." HAZARDS:" cr 
   ." *BOTTOMLESS PITS: two rooms have bottom-"
   ." less pits in them. If you go there, you "
   ." fall into the pit (& lose!)" cr cr 
   ." * SUPER BATS: two other rooms have super"
   ." bats. if you go there, a bat grabs you  "
   ." and takes you to some other room at     "
   ." random. (which might be troublesome!)" cr
wait 
   ." * WUMPUS: the wumpus is not bothered by "
   ." the hazards (he has sucker feet and is  "
   ." too big for a bat to lift). Usually he  "
   ." is asleep. Two things wake him up: your "
   ." entering his room or your shooting an   "
   ." arrow. If the wumpus wakes, he moves one"
   ." room or stays still. After that, if he  "
   ." is where you are, he eats you up and you"
   ." lose!" cr
wait
   ." ABOUT YOU:" cr 
   ." Each turn you may move or shoot an arrow"
   ." MOVING: you can go one room [thru one   "
   ." tunnel)." cr
   ." ARROWS: you have 5 arrows. You lose when"
   ." you run out. Each arrow can go from 1 to"
   ." 5 rooms. You aim by telling the computer"
   ." the number of rooms you want the arrow  "
   ." to go to. If the arrow can't go that way"
   ." [ie no tunnel) it moves at ramdom to the"
   ." next room. If the arrow hits the wumpus,"
   ." you win. If the arrow hits you...."
wait
   ." WARNINGS:"
cr ." When you are one room away from wumpus  "
   ." or hazard, the computer says:" cr 
   ." Wumpus:  'i smell a wumpus'" cr 
   ." Bat:     'bats nearby'" cr 
   ." Pit:     'i feel a draft'"
wait ;

: yesno ( addr u -- f )
    cr type
    begin
        key upper dup ascii Y = over ascii N = or
    until
    dup emit ascii Y = ;

: game
    0 gmode 
    ." Welcome to Hunt The Wumpus!!!!" CR
    s" INSTRUCTIONS (Y-N) ? " yesno if
    instructions
    then
    begin
        setup
        0 gameover !
        begin
            gameloop 
            gameover @
        until
        s" Play again (Y-N) ? " yesno 0=
    until ;
